home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / comm2 / alist.lha / src / alpost.e < prev    next >
Text File  |  1995-11-08  |  15KB  |  448 lines
  1. /* ALPost.M */
  2.  
  3. OPT MODULE
  4. OPT EXPORT
  5.  
  6. /* Module to post messages to lists managed by this server */
  7. MODULE 'dos/datetime'
  8. MODULE 'dos/dos'
  9. MODULE 'other/aladd'
  10. MODULE 'other/alcmd'
  11. MODULE 'other/alconfig'
  12. MODULE 'other/allog'
  13.  
  14. /* These are for the replace_strings() function */
  15. SET RPLC_LIST, RPLC_OWN, RPLC_FROM, RPLC_TO, RPLC_DATE, RPLC_SUBJ, RPLC_KEY, RPLC_MSG, RPLC_OUT
  16. /* Everything that's currently supported */
  17. CONST RPLC_ALL=RPLC_LIST OR RPLC_OWN OR RPLC_FROM
  18.  
  19.  
  20. DEF temp_file:PTR TO CHAR, hostname:PTR TO CHAR, list_dir
  21.  
  22. /*
  23.  * Directs a message to the appropriate destination.
  24.  */
  25. PROC examine_message (str:PTR TO CHAR)
  26.    DEF str1:PTR TO CHAR, tmp:PTR TO config_node, str2:PTR TO CHAR, flag
  27.  
  28.    LowerStr (str)
  29.  
  30.    IF (StrCmp (str, 'alist'))
  31.       do_command (str)
  32.       RETURN
  33.    ENDIF
  34.  
  35.    flag := 0
  36.    str1 := InStr (str, '-list-request')
  37.    IF (str1 = -1)
  38.       str1 := InStr (str, '-request')
  39.       IF (str1 = -1)
  40.          str1 := InStr (str, '-list-owner')
  41.          IF (str1 = -1)
  42.             str1 := InStr (str, '-owner')
  43.             IF (str1 = -1)
  44.                str1 := InStr (str, '-list')
  45.             ELSE
  46.                flag := 2   /* -owner, forward to the owner */
  47.             ENDIF
  48.          ELSE
  49.             flag := 2      /* -list-owner, forward to the owner */
  50.          ENDIF
  51.       ELSE
  52.          flag := 1      /* -request, forward to AList, with a default list */
  53.       ENDIF
  54.    ELSE
  55.       flag := 1         /* -list-request, forward to AList, with a default list */
  56.    ENDIF
  57.  
  58.    IF (str1 > -1)
  59.       str1 := String (str1)
  60.       StrCopy (str1, str)
  61.    ELSE
  62.       str1 := str
  63.    ENDIF
  64.  
  65.    tmp := find_list (str1)
  66.  
  67.    IF (tmp = NIL)
  68.       clear_tmp_file()
  69.       add_tmp_file ('\nNo user or mailing list by the name of "')
  70.       add_tmp_file (str1)
  71.       add_tmp_file ('" found.\n\n')
  72.       str2 := String (71 + StrLen (Next (str)))
  73.       StringF (str2, '-f AList -R "AList Mailing List Server" -s "BOUNCE: No such user" -t "\s"', Next (str))
  74.       send_message (str2)
  75.       DisposeLink (str2)
  76.    ELSE
  77.       /* Found a list it goes to */
  78.       IF (flag = 2)
  79.          /* It's a -owner message, it should go to the owner. */
  80.          clear_tmp_file ()
  81.          fill_tmp_file (Next (Next (str)))
  82.          str2 := String (5 + StrLen (tmp.owner))
  83.          StringF (str2, '-t "\s"', tmp.owner)
  84.          send_message (str2)
  85.          DisposeLink (str2)
  86.       ELSEIF (flag = 1)
  87.          /* It's a -request, it should go to the AList with a default list */
  88.          /* Note that str1 is NOT equal to str, if we got here. */
  89.          Link (str1, Next(str))
  90.          do_command (str1)
  91.       ELSE
  92.          /* It's a post */
  93.          post_list (tmp, Next (str), Next (Next (str)))
  94.       ENDIF
  95.    ENDIF
  96.  
  97.    IF (str1 <> str)  THEN DisposeLink (str1)
  98. ENDPROC
  99.  
  100.  
  101. /*
  102.  * Post a message to a list, passing the arguments on to SMTPpost
  103.  */
  104. PROC send_message (str)
  105.    DEF str2:PTR TO CHAR, tmp
  106.  
  107.    IF (str)
  108.       str2 := String (StrLen (str) + EstrLen (temp_file) + 19)
  109.       StrCopy (str2, 'SMTPpost <"')
  110.       StrAdd (str2, temp_file)
  111.       StrAdd (str2, '" >NIL: ')
  112.       StrAdd (str2, str)
  113.    ELSE
  114.       str2 := String (EstrLen (temp_file) + 19)
  115.       StrCopy (str2, 'SMTPpost <"')
  116.       StrAdd (str2, temp_file)
  117.       StrAdd (str2, '" >NIL: ')
  118.    ENDIF
  119.  
  120.    IF (Execute (str2, NIL, NIL))
  121.       log_message ('Mailed: ', LOG_INFO)
  122.       log_message (str2, LOG_INFO2)
  123.       log_message ('\n', LOG_INFO2)
  124.    ELSE
  125.       log_message ('SMTPpost Failed: ', LOG_ERROR)
  126.       log_message (str2, LOG_ERROR2)
  127.       log_message ('\n', LOG_ERROR2)
  128.    ENDIF
  129.  
  130.    DisposeLink (str2)
  131. ENDPROC
  132.  
  133.  
  134. /*
  135.  * Post a message to the list, based on the list options
  136.  *
  137.  * msg is really a linked estring chain containing first headers then the body
  138.  */
  139. PROC post_list (list:PTR TO config_node, from:PTR TO CHAR, msg:PTR TO CHAR)
  140.    DEF is_header, has_subject, who:PTR TO CHAR, str:PTR TO CHAR, prev, i, flag
  141.    DEF h_from, h_subj, h_date, tmpstr, fd, stamp:PTR TO datestamp, old_dir, str2
  142.  
  143.    clear_tmp_file()
  144.  
  145.    h_from := h_subj := h_date := NIL
  146.  
  147.    str := String (31 + (2 * EstrLen (list.name)))
  148.    StringF (str, '-f \s-list-owner -t \s-list-members', list.name, list.name)
  149.  
  150.    is_header := (is_empty (msg) = FALSE);  has_subject := FALSE;  prev := NIL
  151.    WHILE (IF (msg)  THEN (is_header) ELSE FALSE)
  152.       IF (IF (list.subject)  THEN (StrCmp (msg, 'Subject: ', 9)) ELSE FALSE)
  153.          has_subject := InStr (msg, list.subject)     /* This will never be 0 */
  154.          IF (has_subject = -1)
  155.             who := String (EstrLen (msg) + EstrLen (list.subject))
  156.             StringF (who, 'Subject: \s\s', list.subject, msg + 9)
  157.             /* A little hack here, since the only place that calls this uses msg as Next (from) */
  158.             IF (prev)  THEN Link (prev, who) ELSE Link (from, who)
  159.             Link (who, Next (msg))
  160.             Link (msg, NIL)         /* We don't want to unlink the rest of the message! */
  161.             DisposeLink (msg)
  162.             msg := who
  163.          ENDIF
  164.       ENDIF
  165.  
  166.       IF (list.digest)
  167.          IF (StrCmp (msg, 'Subject: ', 9))
  168.             h_subj := msg
  169.          ELSEIF (StrCmp (msg, 'From: ', 6))
  170.             h_from := msg
  171.          ELSEIF (StrCmp (msg, 'Date: ', 6))
  172.             h_date := msg
  173.          ENDIF
  174.       ENDIF
  175.  
  176.       /* Content-Length: is always wrong here */
  177.       IF (StrCmp (msg, 'Content-Length:', 15) = FALSE) AND
  178.          (StrCmp (msg, 'Approved:', 9) = FALSE)
  179.          add_tmp_file (msg)
  180.       ENDIF
  181.       prev := msg
  182.       msg := Next (msg)
  183.       is_header := (is_empty (msg) = FALSE)
  184.    ENDWHILE
  185.  
  186.    IF (IF (has_subject = FALSE)  THEN (list.subject <> NIL) ELSE FALSE)
  187.       /* add in subject */
  188.       who := String (10 + EstrLen (list.subject))
  189.       StringF (who, 'Subject: \s\n', list.subject)
  190.       /* See the comment above on this hack */
  191.       IF (prev)  THEN Link (prev, who) ELSE Link (from, who)
  192.       Link (who, msg)
  193.       prev := who
  194.       add_tmp_file (who)
  195.       IF (list.digest)  THEN h_subj := who
  196.    ENDIF
  197.  
  198.    who := list.users
  199.    IF (who)  THEN add_tmp_file ('Bcc: ')
  200.    i := 5
  201.    WHILE (who)
  202.       add_tmp_file (who)
  203.       IF (Next (who))
  204.          add_tmp_file (', ')
  205.          i := i + EstrLen (who) + 2
  206.          IF (i > 60)
  207.             add_tmp_file ('\n\t')
  208.             i := 8
  209.          ENDIF
  210.       ENDIF
  211.  
  212.       who := Next (who)
  213.    ENDWHILE
  214.    add_tmp_file ('\n')
  215.  
  216.    /* Add in the headers, if any */
  217.    IF (list.header)
  218.       who := String (EstrLen (list.header))
  219.       StrCopy (who, list.header)
  220.       who := replace_strings (RPLC_ALL, who, list, from)
  221.       add_tmp_file (who)
  222.       DisposeLink (who)
  223.    ENDIF
  224.  
  225.    fd := NIL
  226.    IF (list.digest)
  227.       tmpstr := String (EstrLen (list.name) + 7)
  228.       StringF (tmpstr, '\s.digest', list.name)
  229.       old_dir := CurrentDir (list_dir)
  230.       fd := Open (tmpstr, MODE_READWRITE)
  231.       IF (fd = NIL)
  232.          log_message ('Unable to open digest file for list "', LOG_ERROR)
  233.          log_message (list.name, LOG_ERROR2)
  234.          log_message ('".\n', LOG_ERROR2)
  235.       ELSE
  236.          Seek (fd, 0, OFFSET_END)
  237.          IF (list.digest.time = NIL)
  238.             /* List hasn't been opened yet */
  239.             IF (Seek (fd, 0, OFFSET_CURRENT) > 1)
  240.                /* We aren't at the start of the file! */
  241.                log_message ('Time/Date stamp and Number of Lines lost for existing digest\n' +
  242.                             '\tfor list "', LOG_ERROR)
  243.                log_message (list.name, LOG_ERROR2)
  244.                log_message ('"!\n', LOG_ERROR2)
  245.                list.digest.current_size := Seek (fd, 0, OFFSET_CURRENT)
  246.             ELSE
  247.                list.digest.current_size := NIL
  248.             ENDIF
  249.  
  250.             list.digest.time := DateStamp (New (SIZEOF datetime))
  251.             list.digest.current_lines := 4         /* The Subject: xxx\n\n*** BEGIN ... *** \n lines */
  252.  
  253.             who := String (80)
  254.             StringF (who, 'Subject: \s Digest, \s #\d', list.name,
  255.                IF (list.digest.iname)  THEN list.digest.iname ELSE 'ISSUE', list.digest.issue)
  256.             Fputs (fd, who)
  257.             IF (list.digest.volume)
  258.                StringF (who, '  \s #\d\n', IF (list.digest.vname)  THEN list.digest.vname ELSE 'VOLUME', list.digest.volume)
  259.                Fputs (fd, who)
  260.             ELSE
  261.                FputC (fd, "\n")
  262.             ENDIF
  263.  
  264.             IF (list.digest.header)
  265.                Fputs (fd, list.digest.header)
  266.                list.digest.current_lines := list.digest.current_lines + count (list.digest.header, "\n")
  267.             ENDIF
  268.  
  269.             StringF (who, '\n*** BEGIN DIGEST \s #\d', IF (list.digest.iname)  THEN list.digest.iname ELSE 'ISSUE', list.digest.issue)
  270.             Fputs (fd, who)
  271.             IF (list.digest.volume)
  272.                StringF (who, ', \s #\d', IF (list.digest.vname)  THEN list.digest.vname ELSE 'VOLUME', list.digest.volume)
  273.             ENDIF
  274.             Fputs (fd, who)
  275.             Fputs (fd, ' ***\n')
  276.  
  277.             DisposeLink (who)
  278.             list.digest.current_size := Seek (fd, 0, OFFSET_CURRENT)
  279.          ELSE
  280.             /* It's a second or higher message, add in the separator */
  281.             Fputs (fd, '\n')
  282.             IF (list.digest.footer)
  283.                Fputs (fd, list.digest.footer)
  284.                list.digest.current_lines := list.digest.current_lines + count (list.digest.footer, "\n") + 1
  285.             ENDIF
  286.          ENDIF
  287.  
  288.          Fputs (fd, '\n')
  289.          IF (h_from)
  290.             Fputs (fd, h_from)
  291.          ELSE
  292.             Fputs (fd, 'From: ???\n')
  293.          ENDIF
  294.  
  295.          IF (h_date)
  296.             Fputs (fd, h_date)
  297.          ELSE
  298. /* REALLY should calc date from list.digest.time here, it's already a DateTime struct... */
  299.             Fputs (fd, 'Date: ???\n')
  300.          ENDIF
  301.  
  302.          IF (h_subj)
  303.             Fputs (fd, h_subj)
  304.          ELSE
  305.             Fputs (fd, 'Subject: (no subject)\n')
  306.          ENDIF
  307.          Fputs (fd, '\n')
  308.          list.digest.current_lines := list.digest.current_lines + 5
  309.       ENDIF
  310.    ENDIF
  311.  
  312.    /* Now add the rest of the message */
  313.    WHILE (msg)
  314.       add_tmp_file (msg)
  315.       IF (fd)
  316.          Fputs (fd, msg)
  317.          list.digest.current_lines := list.digest.current_lines + 1
  318.       ENDIF
  319.       msg := Next (msg)
  320.    ENDWHILE
  321.  
  322.    /* Now add the footer, if any */
  323.    IF (list.header)  THEN add_tmp_file (list.footer)
  324.  
  325.    send_message (str)
  326.  
  327.    /* Check if we need to send a digest issue */
  328.    IF (fd)
  329.       list.digest.current_size := Seek (fd, 0, OFFSET_CURRENT)
  330.       flag := 0
  331.       IF (list.digest.lines)
  332.          IF (list.digest.current_lines >= list.digest.lines)  THEN flag := 1
  333. IF (flag = 1)  THEN WriteF ('lines flip: current=\d, max=\d\n', list.digest.current_lines, list.digest.lines)
  334.       ENDIF
  335.       IF (list.digest.size)
  336.          IF (list.digest.current_size >= Shl (list.digest.size, 10))  THEN flag := 2
  337. IF (flag=2)  THEN WriteF ('size flip: current=\d, max=\dK\n', list.digest.current_size, list.digest.size)
  338.       ENDIF
  339.       IF (list.digest.age)
  340.          NEW stamp
  341.          stamp := DateStamp (stamp)
  342.          IF ((stamp.days - list.digest.age) >= list.digest.time.stamp.days)  THEN flag := 4
  343. IF (flag=4)  THEN WriteF ('age flip: current=\d, first=\d,  max=\d\n', stamp.days, list.digest.time.stamp.days, list.digest.age)
  344.          END stamp
  345.       ENDIF
  346.  
  347.       IF (flag)
  348.          /* Gotta send a digest issue */
  349.          who := String (80)
  350.          StringF (who, '\n*** END DIGEST \s #\d', IF (list.digest.iname)  THEN list.digest.iname ELSE 'ISSUE', list.digest.issue)
  351.          Fputs (fd, who)
  352.          list.digest.issue := list.digest.issue + 1
  353.          IF (list.digest.volume)
  354.             StringF (who, ', \s #\d ***\n', IF (list.digest.vname)  THEN list.digest.vname ELSE 'VOLUME', list.digest.volume)
  355.             Fputs (fd, who)
  356.             IF (list.digest.issue > list.digest.i_v)
  357.                list.digest.issue := 1
  358.                list.digest.volume := list.digest.volume + 1
  359.             ENDIF
  360.          ELSE
  361.             Fputs (fd, ' ***\n\n')
  362.          ENDIF
  363.          list.digest.current_lines := 0
  364.          list.digest.current_size := 0
  365.  
  366.          Seek (fd, 0, OFFSET_BEGINNING)
  367.          who := load_in_file (fd)
  368.          str2 := String (EstrLen (list.name) + StrLen (hostname) + 1)
  369.          StringF (str2, '\s@\s', list.name, hostname)
  370.          /* WARNING:  This could cause an endless loop if digest lists have digests! */
  371.          post_list (find_list (list.digest.name), str2, who)
  372.          DisposeLink (who)
  373.          Close (fd)
  374.          DeleteFile (tmpstr)
  375.          Dispose (list.digest.time)
  376.          list.digest.time := NIL
  377.       ELSE
  378.          Close (fd)
  379.       ENDIF
  380.       write_issue (list)
  381.       CurrentDir (old_dir)
  382.       DisposeLink (tmpstr)
  383.    ENDIF
  384. ENDPROC
  385.  
  386.  
  387. /*
  388.  * Replace certain strings, based on flags
  389.  *
  390.  *    $MSG     Entire message (really, temp file name).
  391.  *    $OUT     File used to collect the output.
  392.  *    $USER    Don't use this one. (Only valid on crypt/decrypt anyway)
  393.  *    $FROM    Sender of the message.
  394.  *    $TO      Only used for crypt/decrypt.
  395.  *    $KEY     Only used for crypt/decrypt.
  396.  *    $DATE    Full date string.
  397.  *    $SUBJ    The subject line.
  398.  *    $LIST    List name.
  399.  *    $OWN     List owner.
  400.  */
  401. PROC replace_strings (flags, str:PTR TO CHAR, list:PTR TO config_node,
  402.                            from=NIL, to=NIL, date=NIL, subj=NIL, key=NIL)
  403.    DEF str1:PTR TO CHAR
  404.  
  405.    IF (str = NIL) OR (list = NIL)  THEN RETURN
  406.  
  407.    IF (flags AND RPLC_LIST)
  408.       IF (hostname)
  409.          str1 := String (StrLen (list.name) + StrLen (hostname) + 1)
  410.          StringF (str1, '\s@\s', list.name, hostname)
  411.          str := low_replace (str, '$LIST', str1)
  412.          DisposeLink (str1)
  413.       ELSE
  414.          str := low_replace (str, '$LIST', list.name)
  415.       ENDIF
  416.    ENDIF
  417.    IF (flags AND RPLC_OWN)   THEN str := low_replace (str, '$OWN', list.owner)
  418.    IF (flags AND RPLC_FROM)  THEN str := low_replace (str, '$FROM', from)
  419.    IF (flags AND RPLC_TO)    THEN str := low_replace (str, '$TO', to)
  420.    IF (flags AND RPLC_DATE)  THEN str := low_replace (str, '$DATE', date)
  421.    IF (flags AND RPLC_SUBJ)  THEN str := low_replace (str, '$SUBJ', subj)
  422.    IF (flags AND RPLC_KEY)   THEN str := low_replace (str, '$KEY', key)
  423.    IF (flags AND RPLC_MSG)   THEN str := low_replace (str, '$MSG', temp_file)
  424.    IF (flags AND RPLC_OUT)   THEN str := low_replace (str, '$OUT', 'T:alist.out')
  425. ENDPROC str
  426.  
  427.  
  428. /*
  429.  * low-level function for string replacement
  430.  */
  431. PROC low_replace (str:PTR TO CHAR, fix:PTR TO CHAR, ins:PTR TO CHAR)
  432.    DEF s:PTR TO CHAR, x, s2:PTR TO CHAR, len, len2
  433.  
  434.    x := 0;  s2 := str;  len := StrLen (fix)
  435.    IF (ins)  THEN len2 := StrLen (ins)  ELSE len2 := NIL
  436.    WHILE ((x := InStr (s2, fix, x)) > -1)
  437.       s := String (EstrLen (s2) - len + len2)
  438.       IF (x > 0)  THEN StrCopy (s, s2, x-1)
  439.       IF (len2)  THEN StrAdd (s, ins)
  440.       IF (x+len < EstrLen (s2))  THEN StrAdd (s, s2+x+len)
  441.       DisposeLink (s2)
  442.       s2 := s
  443.       x := x + len2
  444.    ENDWHILE
  445. ENDPROC s2
  446.  
  447.  
  448.